home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / bfl / bfl.lha / cfortest.c next >
C/C++ Source or Header  |  1992-10-28  |  17KB  |  548 lines
  1. /* cfortest.c */
  2. /* Burkhard Burow, burow@vxdesy.cern.ch, U. of Toronto, 1992. */
  3.  
  4. #include <stdio.h>
  5. #include "cfortran.h"
  6.  
  7. #define EASY_SELECT     /* To see the various examples select one of: 
  8.         EASY_SELECT,SUBT_SELECT,  SZ_SELECT,  FT_SELECT, FZ_SELECT, SS1_SELECT,
  9.          ABC_SELECT,  RR_SELECT, REV_SELECT, FCB_SELECT, EQ_SELECT, F0_SELECT,
  10.           FA_SELECT,  FB_SELECT,  FC_SELECT,  FD_SELECT, FE_SELECT, FF_SELECT,
  11.           FG_SELECT,  FH_SELECT,  FI_SELECT,  FJ_SELECT, FK_SELECT, FL_SELECT,
  12.           FM_SELECT,  FN_SELECT,FAND_SELECT,FORR_SELECT, E2_SELECT, 
  13.       STRTOK_SELECT,USER_SELECT.  */
  14.  
  15. #ifdef NAGf90Fortran
  16. /* NAG f90 library hijacks main() and the user's program starts with a call to
  17.    void f90_main(void);                   
  18.    No real problem here, but woe is the C appliation which uses command line
  19.    arguments for which NAG f90 provides no support. */
  20. #define main f90_main
  21. #endif
  22.  
  23. #ifdef EASY_SELECT
  24. #define EASY(A,B)      CCALLSFSUB2(EASY,easy,PINT,INT, A,B)
  25.  
  26. main() {
  27. int a;
  28. printf("\nEASY EXAMPLE\n");
  29. EASY(a,7);
  30. printf("The FORTRAN routine EASY(a,7) returns a = %d\n", a);
  31. }
  32. #endif
  33.  
  34. #ifdef SUBT_SELECT
  35. #define SUBT(A,B,C) CCALLSFSUB3(SUBT,subt,PSTRINGV,STRINGV,FLOAT,A,B,C)
  36.  
  37. int main() {
  38. static char v[][5] = {"000 ", "1", "22", " "};
  39. static char w[][9]  = {" ", "bb","ccc ","dddd"};
  40. SUBT(v, w, 10.);
  41. printf("main:v=%s,%s,%s,%s. PSTRINGV => Has had trailing blanks stripped.\n",
  42.        v[0],v[1],v[2],v[3]);
  43. printf("main:w=%s,%s,%s,%s. STRINGV => malloc'd copy for FORTRAN=> C intact.\n"
  44.        ,w[0],w[1],w[2],w[3]);
  45. }
  46. #endif
  47.  
  48. #ifdef SZ_SELECT
  49. #define sz_ELEMS_1   ZTRINGV_ARGS(3)
  50. #define sz_ELEMLEN_1 ZTRINGV_NUM(6)
  51. #define sz_ELEMS_2   ZTRINGV_NUM(4)
  52. #define sz_ELEMLEN_2 ZTRINGV_NUM(8)
  53. #define SZ(A,B,C) CCALLSFSUB3(SZ,sz,PZTRINGV,ZTRINGV,INT,A,B,C)
  54.  
  55. int main() {
  56. static char v[][7] = {"000 ", "1", "22", " "};
  57. static char w[][9]  = {" ", "bb","ccc ","dddd"};
  58. SZ(v, w, 4);
  59. printf("main:v=%s,%s,%s,%s. PSTRINGV => Has had trailing blanks stripped.\n",
  60.        v[0],v[1],v[2],v[3]);
  61. printf("main:w=%s,%s,%s,%s. STRINGV => malloc'd copy for FORTRAN=> C intact.\n"
  62.        ,w[0],w[1],w[2],w[3]);
  63. }
  64. #endif
  65.  
  66. #ifdef FT_SELECT
  67. PROTOCCALLSFFUN3(STRING,FT,ft,PSTRINGV,STRINGV,FLOAT)
  68. #define FT(A,B,C) CCALLSFFUN3(FT,ft,PSTRINGV,STRINGV,FLOAT,A,B,C)
  69.  
  70. main() {
  71. static char v[][5] = {"000 ", "1", "22", " "};
  72. static char w[][9]  = {" ", "bb","ccc ","dddd"};
  73. float a = 10.0;
  74. printf("FT(v, w, a); returns:%s.\n",FT(v, w, a));
  75. printf("main:v=%s,%s,%s,%s. PSTRINGV => Has had trailing blanks stripped.\n",
  76.        v[0],v[1],v[2],v[3]);
  77. printf("main:w=%s,%s,%s,%s. STRINGV => malloc'd copy for FORTRAN=> C intact.\n"
  78.        ,w[0],w[1],w[2],w[3]);
  79. }
  80. #endif
  81.  
  82. #ifdef FZ_SELECT
  83. #define fz_ELEMS_1   ZTRINGV_ARGF(3)
  84. #define fz_ELEMLEN_1 ZTRINGV_NUM(6)
  85. #define fz_ELEMS_2   ZTRINGV_NUM(4)
  86. #define fz_ELEMLEN_2 ZTRINGV_NUM(8)
  87. PROTOCCALLSFFUN3(STRING,FZ,fz,PZTRINGV,ZTRINGV,INT)
  88. #define FZ(A,B,C) CCALLSFFUN3(FZ,fz,PZTRINGV,ZTRINGV,INT,A,B,C)
  89.  
  90. main() {
  91. static char v[][7] = {"000 ", "1", "22", " "};
  92. static char w[][9]  = {" ", "bb","ccc ","dddd"};
  93. printf("FZ(v, w, a); returns:%s.\n",FZ(v, w, 4));
  94. printf("main:v=%s,%s,%s,%s. PSTRINGV => Has had trailing blanks stripped.\n",
  95.        v[0],v[1],v[2],v[3]);
  96. printf("main:w=%s,%s,%s,%s. STRINGV => malloc'd copy for FORTRAN=> C intact.\n"
  97.        ,w[0],w[1],w[2],w[3]);
  98. }
  99. #endif
  100.  
  101. #ifdef SS1_SELECT
  102. #define SS1(A1)             CCALLSFSUB1(SS1,ss1,PSTRING,A1)
  103. #define FORSTR1(A1)         CCALLSFSUB1(FORSTR1,forstr1,PSTRING,A1)
  104.  
  105. main() {
  106. static char b[] = "abcdefghij", forb[13] = "abcdefghijkl";
  107. SS1(b); FORSTR1(forb);
  108. printf("SS1(b) returns b = %s; FORSTR1(forb) = returns forb = %s;\n", b, forb);
  109. }
  110. #endif
  111.  
  112. #ifdef ABC_SELECT
  113. #define ABC(A1,A2,A3)       CCALLSFSUB3(ABC,abc,STRING,PSTRING,PSTRING,A1,A2,A3)
  114.  
  115. main() {
  116. static char aa[] = "one  ", bb[] = "two  ", cc[] = "three"; int i; 
  117. for (i=0; i<10; i++) {printf("%s;%s;%s;\n",aa,bb,cc); ABC(aa,bb,cc);}
  118. }
  119. #endif
  120.  
  121. #ifdef RR_SELECT
  122. PROTOCCALLSFFUN1(FLOAT,RR,rr,INT)
  123. #define RR(A1)               CCALLSFFUN1(RR,rr,INT,A1)
  124. PROTOCCALLSFFUN0(STRING,FORSTR2,forstr2)
  125. #define FORSTR2()           CCALLSFFUN0(FORSTR2,forstr2)
  126. PROTOCCALLSFFUN1(STRING,FORSTR,forstr,STRING)
  127. #define FORSTR(A1)          CCALLSFFUN1(FORSTR,forstr,STRING,A1)
  128.  
  129. main() {
  130. static char aa[] = "one";
  131. int rrr = 333;
  132. printf("RR(rrr=%d) returns int arg. as float:%f\n",rrr,RR(rrr));
  133. printf("FORSTR(aa=%s) returns the string arg. as:%s<-end here\n",aa,FORSTR(aa));
  134. printf("FORSTR2() returns the string constant:%s<-end here\n",FORSTR2());
  135. }
  136. #endif
  137.  
  138. #ifdef REV_SELECT
  139. PROTOCCALLSFFUN1(INT,FREV,frev,INTV)
  140. #define FREV(A1)               CCALLSFFUN1(FREV,frev,INTV,A1)
  141. #define REV(A1)                CCALLSFSUB1(REV,rev,INTV,A1)
  142.  
  143. main() {
  144. static int a[] = {1,2};
  145. printf("REV(a[0,1]=%d,%d) receives:",a[0],a[1]);
  146. REV(a); printf("a[0,1]=%d,%d\n",a[0],a[1]);
  147. printf("FREV(a[0,1]=%d,%d) receives:",a[0],a[1]);
  148. printf("%d",FREV(a)); printf(" with a[0,1]=%d,%d\n",a[0],a[1]);
  149. }
  150. #endif
  151.  
  152. #ifdef FCB_SELECT
  153. #define FFCB()                 CCALLSFSUB0(FFCB,ffcb)
  154.  
  155. typedef struct { char v[13],w[4][13],x[2][3][13]; } FCB_DEF;
  156. #define Fcb COMMON_BLOCK(FCB,fcb)
  157. COMMON_BLOCK_DEF(FCB_DEF,Fcb);
  158. FCB_DEF Fcb;
  159.  
  160. main() {
  161. char cv[14];
  162. static char cw[4][14]    = {"C's w[0]", "C's w[1]", "C's w[2]", "C's w[3]"};
  163. static char cx[2][3][14] = {"C's x[0][0]", "C's x[0][1]", "C's x[0][2]", 
  164.                             "C's x[1][0]", "C's x[1][1]", "C's x[1][2]"};
  165. C2FCBSTR("C's V" ,Fcb.v,0);
  166. C2FCBSTR(cw      ,Fcb.w,1);
  167. C2FCBSTR(cx      ,Fcb.x,2);
  168. FFCB();
  169. FCB2CSTR(Fcb.v   ,cv   ,0);
  170. FCB2CSTR(Fcb.w   ,cw   ,1);
  171. FCB2CSTR(Fcb.x   ,cx   ,2);
  172. printf("FFCB returns v = %s.\n",cv);
  173. printf("FFCB returns w[1,2,3,4] = %s,%s,%s,%s.\n",cw[0],cw[1],cw[2],cw[3]);
  174. printf("FFCB returns x[0,(1,2,3)] = %s,%s,%s.\n",cx[0][0],cx[0][1],cx[0][2]);
  175. printf("FFCB returns x[1,(1,2,3)] = %s,%s,%s.\n",cx[1][0],cx[1][1],cx[1][2]);
  176. }
  177. #endif
  178.  
  179. #ifdef EQ_SELECT
  180. #define FEQ()                 CCALLSFSUB0(FEQ,feq)
  181.  
  182. #define KWBANK 690
  183. typedef struct {
  184.   int nzebra; float gversn,zversn; int ixstor,ixdiv,ixcons; float fendq[16];
  185.   union {
  186.     struct {
  187.       int Lmain,Lr1; 
  188.       union {float Ws[KWBANK]; int Iws[2];}u;
  189.     }s;
  190.     union {
  191.       int Lq[80];
  192.       struct {
  193.         int dummy[8];
  194.         union {float Q[2]; int Iq[2];}u;
  195.       }s;
  196.     }u;
  197.   }u;
  198. } GCBANK_DEF;
  199. #define lmain u.s.Lmain
  200. #define lr1   u.s.Lr1
  201. #define ws    u.s.u.Ws
  202. #define iws   u.s.u.Iws
  203. #define lq    u.u.Lq
  204. #define q     u.u.s.u.Q
  205. #define iq    u.u.s.u.Iq
  206. #define GCbank COMMON_BLOCK(GCBANK,gcbank)
  207. COMMON_BLOCK_DEF(GCBANK_DEF,GCbank);
  208. GCBANK_DEF GCbank;
  209.  
  210. main() {
  211. FEQ();
  212. printf("GCbank.nzebra       = %d.\n", GCbank.nzebra);
  213. printf("GCbank.gversn       = %f.\n", GCbank.gversn);
  214. printf("GCbank.zversn       = %f.\n", GCbank.zversn);
  215. printf("GCbank.ixstor       = %d.\n", GCbank.ixstor);
  216. printf("GCbank.ixcons       = %d.\n", GCbank.ixcons);
  217. printf("GCbank.fendq[15]    = %f.\n", GCbank.fendq[15]);
  218. printf("GCbank.lmain        = %d.\n", GCbank.lmain);
  219. printf("GCbank.lr1          = %d.\n", GCbank.lr1);
  220. printf("GCbank.ws[KWBANK-1] = %f.\n", GCbank.ws[KWBANK-1]);
  221. printf("GCbank.iq[0]        = %d.\n", GCbank.iq[0]);
  222. }
  223. #endif
  224.  
  225. /* The following functions, exist through cor, are called by FORTRAN functions,
  226.    as shown by the remaining examples. */
  227.  
  228. #ifdef CF_SAME_NAMESPACE
  229. /* 
  230. VAX/VMS, HP-UX (without FORTRAN's -U option), and the IBMR2(without FORTRAN's
  231. -qextname option) have C and FORTRAN sharing the same name space. The name space
  232. is case-insensitive for VAX/VMS. There are several ways, some are described in
  233. cfortran.doc, to meet this constraint, which is only a difficulty for C
  234. routines to be called by FORTRAN.
  235.  
  236. The conflict is explicitly avoided, as shown, for the routines: ca, cb, cc, cd.
  237.  
  238. For VAX/VMS we need to change the name, (changing the case is not enough since
  239. VAX/VMS is case insensitive. This is done implicitly via the defines given 
  240. below: 
  241.  
  242. For the IBM and the HP, we have chosen to name the C routines using a Proper 
  243. Case notation, i.e:
  244.                    Exist, Ce, Ccff, Ccg, Cch, Ci, Cj, Ck, Cl, Cm, Cn, Cand, Cor.
  245. instead of the usual C convention:
  246.                    exist, ce, ccff, ccg, cch, ci, cj, ck, cl, cm, cn, cand, cor.
  247.  
  248. NOTE THAT THIS DEMO WILL STILL RUN ON ALL MACHINES, EXCEPT THE HP9000 AND THE
  249. IBM RS/6000(no -qextname), IF 'Exist', ETC. ARE CHANGED TO LOWER CASE. i.e. It
  250. is only these two machines which cause us to go against the C naming norm.'s.
  251. */
  252.  
  253. #if defined(VAXC) && defined(vms)
  254. #define Exist EXIST_
  255. /*#define ca    CA_*/    /* We don't do this since we've decided to call the
  256.                             routine ca from FORTRAN  as CFORTRANCA.           */
  257. /*#define cb    CB_*/    /* Similarly we call cb as CFCB.                     */
  258. /*#define cc    CC_*/    /*               and cc as CFCC.                     */
  259. /*#define cd    CD_*/    /*               and cd as   CDCFORT.                */
  260. #define Ce    CE_
  261. #define Ccff  CCFF_
  262. #define Ccg   CCG_
  263. #define Cch   CCH_
  264. #define Ci    CI_
  265. #define Cj    CJ_
  266. #define Ck    CK_
  267. #define Cl    CL_
  268. #define Cm    CM_
  269. #define Cn    CN_
  270. #define Cand  CAND_
  271. #define Cor   COR_
  272. #endif                      /* VAXC and vms       */
  273. #endif                      /* CF_SAME_NAMESPACE */
  274.  
  275. void Exist() {printf("exist: was called.\n");}
  276. FCALLSCSUB0(Exist,EXIST,exist)
  277.  
  278. void ca(i) int i; {printf("ca: had integer argument:%d.\n",i);}
  279. FCALLSCSUB1(ca,CFORTRANCA,cfortranca,INT)
  280. /*           ^      ^-----------^---------FORTRAN name. 
  281.              |__ C name.                                                      */
  282.  
  283.  
  284. /* With the next 2 lines we tell cfortran.h that for the subsequent FCALLSCSUBn
  285.    and FCALLSCSUBn declarations, FORTRAN entry points to C routines have the 
  286.    C name prefaced with the characters 'CF', i.e. whereas the
  287.    C name of the routine is 'cb', the routine is called from FORTRAN as 'CFCB'. 
  288.    Similarly C's cc, is CFCC for FORTRAN. */
  289. #undef  fcallsc
  290. #define fcallsc(UN,LN) preface_fcallsc(CF,cf,UN,LN)
  291.  
  292. void cb(i) int *i; 
  293. {printf("cb: had pointer argument to integer:%d.\n",*i); *i*=2;}
  294. FCALLSCSUB1(cb,CB,cb,PINT)
  295.  
  296. void cc(s) char *s; {printf("cc: had string argument:%s.\n",s);}
  297. FCALLSCSUB1(cc,CC,cc,STRING)
  298.  
  299. /* With the next 2 lines we tell cfortran.h that for the subsequent FCALLSCSUBn
  300.    and FCALLSCSUBn declarations, FORTRAN entry points to C routines have the 
  301.    C name appended with the characters 'CFORT', i.e. whereas the C name of the
  302.    routine is 'cd', the routine is called from FORTRAN as 'CDCFORT'.          */
  303. #undef  fcallsc
  304. #define fcallsc(UN,LN) append_fcallsc(CFORT,cfort,UN,LN)
  305.  
  306. void cd(s) char *s;
  307. {printf("cd: had string argument:%s.\n",s); strcpy(s,"to you 12345678");}
  308. FCALLSCSUB1(cd,CD,cd,PSTRING)
  309.  
  310. #undef  fcallsc
  311. #define fcallsc        orig_fcallsc
  312. /* The preceeding line returns FORTRAN names to being the original C names.   */
  313.  
  314. void Ce(v) char v[][5];
  315. {printf("ce: had string vector argument:%s,%s,%s.\n",v[0],v[1],v[2]);}
  316. #define ce_STRV_A1 TERM_CHARS(' ',1)
  317. FCALLSCSUB1(Ce,CE,ce,STRINGV)
  318.  
  319. void Ccff(v, n) char v[][5]; int n;
  320. {int i;
  321. printf("ccff: had %d string vector argument:",n);
  322. for (i=0; i<n-1; i++) printf("%s,",v[i]);
  323. printf("%s.\n",v[i]);
  324. }
  325. #define ccff_STRV_A1 NUM_ELEM_ARG(2)
  326. FCALLSCSUB2(Ccff,CCFF,ccff,STRINGV,INT)
  327.  
  328.  
  329. int Ccg() {return 1;}
  330. FCALLSCFUN0(INT,Ccg,CCG,ccg)
  331.  
  332. char *Cch() {return "hello";}
  333. FCALLSCFUN0(STRING,Cch,CCH,cch)
  334.  
  335. char *Ci(v) char v[][5]; {return v[3];}
  336. #define ci_STRV_A1 NUM_ELEMS(6)
  337. FCALLSCFUN1(STRING,Ci,CI,ci,STRINGV)
  338.  
  339. char *Cj(v) int v; {printf("cj:v=%d\n",v);return "hello";}
  340. FCALLSCFUN1(STRING,Cj,CJ,cj,INT)
  341.  
  342. float Ck() {return 1.;}
  343. FCALLSCFUN0(FLOAT,Ck,CK,ck)
  344.  
  345. DOUBLE_PRECISION Cl() {return 1.;}
  346. FCALLSCFUN0(DOUBLE,Cl,CL,cl)
  347.  
  348. float Cm(a) float a; {return a;}
  349. FCALLSCFUN1(FLOAT,Cm,CM,cm,FLOAT)
  350.  
  351. DOUBLE_PRECISION Cn(a,b) DOUBLE_PRECISION a; DOUBLE_PRECISION b; {return a+b;}
  352. FCALLSCFUN2(DOUBLE,Cn,CN,cn,DOUBLE,DOUBLE)
  353.  
  354. int Cand(a,b) int a; int b; {return a && b;}
  355. FCALLSCFUN2(LOGICAL,Cand,CAND,cand,LOGICAL,LOGICAL)
  356.  
  357. int Cor(a,b) int *a; int *b; {int t; t= *a;*a= *b;*b=t; return *a || *b;}
  358. FCALLSCFUN2(LOGICAL,Cor,COR,cor,PLOGICAL,PLOGICAL)
  359.  
  360.  
  361. #ifdef F0_SELECT
  362. #define FEXIST()               CCALLSFSUB0(FEXIST,fexist)
  363.  
  364. main() {FEXIST();}
  365. #endif
  366.  
  367. #ifdef FA_SELECT
  368. #define FA(A1)               CCALLSFSUB1(FA,fa,INT,A1)
  369.  
  370. main() {FA(1234);}
  371. #endif
  372.  
  373. #ifdef FB_SELECT
  374. #define FB(A1)               CCALLSFSUB1(FB,fb,PINT,A1)
  375.  
  376. main() 
  377. {int i,ii; i=ii=1234; 
  378.  FB(ii); printf("MAIN: FB(i=%d) returns with i=%d.\n",i,ii);}
  379. #endif
  380.  
  381. #ifdef FC_SELECT
  382. #define FC(A1)               CCALLSFSUB1(FC,fc,STRING,A1)
  383.  
  384. main() {FC("hello");}
  385. #endif
  386.  
  387. #ifdef FD_SELECT
  388. #define FD(A1)               CCALLSFSUB1(FD,fd,PSTRING,A1)
  389.  
  390. main() 
  391. {static char i[] = "happy     "; static char ii[] = "happy      "; 
  392.  FD(ii); printf("MAIN: FD(i=%s) returns with i=%s.\n",i,ii);}
  393. #endif
  394.  
  395. #ifdef FE_SELECT
  396. #define FE(A1)               CCALLSFSUB1(FE,fe,STRINGV,A1)
  397.  
  398. main() 
  399. {static char v[][5] = {"0000", "1", "22", ""}; FE(v);}
  400. #endif
  401.  
  402. #ifdef FF_SELECT
  403. #define FF(A1,A2)               CCALLSFSUB2(FF,ff,STRINGV,INT, A1,A2)
  404.  
  405. main() 
  406. {static char v[][5] = {"0000", "1", "22", ""}; 
  407.  FF(v,sizeof(v)/sizeof v[0]);}
  408. #endif
  409.  
  410. #ifdef FG_SELECT
  411. PROTOCCALLSFFUN0(INT,FG,fg)
  412. #define FG()               CCALLSFFUN0(FG,fg)
  413.  
  414. main() 
  415. {printf("FG() returns %d.\n",FG());}
  416. #endif
  417.  
  418. #ifdef FH_SELECT
  419. PROTOCCALLSFFUN0(STRING,FH,fh)
  420. #define FH()               CCALLSFFUN0(FH,fh)
  421.  
  422. main() 
  423. {printf("FH() returns %s.\n",FH());}
  424. #endif
  425.  
  426. #ifdef FI_SELECT
  427. PROTOCCALLSFFUN1(STRING,FI,fi,STRINGV)
  428. #define FI(A1)               CCALLSFFUN1(FI,fi,STRINGV,A1)
  429.  
  430. main() 
  431. {static char v[][5] = {"0000", "1", "22", "333", "8", "9"}; 
  432.  printf("FI(v) returns %s.\n",FI(v));}
  433. #endif
  434.  
  435. #ifdef FJ_SELECT
  436. PROTOCCALLSFFUN1(STRING,FJ,fj,INT)
  437. #define FJ(A1)               CCALLSFFUN1(FJ,fj,INT,A1)
  438.  
  439. main() 
  440. { printf("FJ(2) returns %s.\n",FJ(2));}
  441. #endif
  442.  
  443. #ifdef FK_SELECT
  444. PROTOCCALLSFFUN0(FLOAT,FK,fk)
  445. #define FK()               CCALLSFFUN0(FK,fk)
  446.  
  447. main() 
  448. {printf("FK() returns %f.\n",FK());}
  449. #endif
  450.  
  451. #ifdef FL_SELECT
  452. PROTOCCALLSFFUN0(DOUBLE,FL,fl)
  453. #define FL()               CCALLSFFUN0(FL,fl)
  454.  
  455. main() 
  456. {printf("FL() returns %f.\n",(double)FL());}
  457. #endif                       /* ^- cast req.d for CRAY. */
  458.  
  459. #ifdef FM_SELECT
  460. PROTOCCALLSFFUN1(FLOAT,FM,fm,FLOAT) 
  461. #define FM(A)               CCALLSFFUN1(FM,fm,FLOAT, A)
  462.  
  463. main() 
  464. {printf("FM(1.) returns %f.\n",FM(1.));}
  465. #endif
  466.  
  467. #ifdef FN_SELECT
  468. PROTOCCALLSFFUN2(DOUBLE,FN,fn,DOUBLE,DOUBLE)
  469. #define FN(A,B)             CCALLSFFUN2(FN,fn,DOUBLE,DOUBLE, A,B)
  470.  
  471. main() 
  472. {printf("FN(1./3, 2./3) returns %f.\n",(double)FN(1./3, 2./3));}
  473. #endif                                /* ^- cast req.d for CRAY. */
  474.  
  475. #ifdef FAND_SELECT
  476. PROTOCCALLSFFUN2(LOGICAL,FAND,fand,LOGICAL,LOGICAL)
  477. #define FAND(A,B)             CCALLSFFUN2(FAND,fand,LOGICAL,LOGICAL, A,B)
  478.  
  479. main() 
  480. {printf("FAND(0, 1) returns %d.\n",FAND(0, 1));}
  481. #endif
  482.  
  483. #ifdef FORR_SELECT
  484. PROTOCCALLSFFUN2(LOGICAL,FORR,forr,PLOGICAL,PLOGICAL)
  485. #define FORR(A,B)             CCALLSFFUN2(FORR,forr,PLOGICAL,PLOGICAL, A,B)
  486.  
  487. main() 
  488. {int a=2, b=0; printf("Calling FORR(a=%d, b=%d).\n", a,b);
  489.                printf("FORR() returned %d.\n", FORR(a, b));
  490.                printf("With a=%d, b=%d.\n", a,b);}
  491. #endif
  492.  
  493. #ifdef E2_SELECT
  494. /* Only to demo. that we can force a wrapper to be used for subroutines. */
  495. PROTOCCALLSFFUN2(VOID,EASY,easy,PINT,INT)
  496. #define EASY(A,B)      CCALLSFFUN2(EASY,easy,PINT,INT, A,B)
  497.  
  498. main() {
  499. int a;
  500. printf("\nEASY (2) EXAMPLE\n");
  501. EASY(a,7);
  502. printf("The FORTRAN routine EASY(a,7) returns a = %d\n", a);
  503. }
  504. #endif
  505.  
  506.  
  507. #include <string.h>
  508. FCALLSCFUN2(STRING,strtok,CSTRTOK,cstrtok,STRING,STRING)
  509.  
  510. #ifdef STRTOK_SELECT
  511. #define FSTRTOK()      CCALLSFSUB0(FSTRTOK,fstrtok)
  512.  
  513. main() {FSTRTOK();}
  514. #endif
  515.  
  516. #ifdef USER_SELECT
  517. /* We define a new type USERINT. [Same functionality as PINT actually.] */
  518.  
  519. #if defined(VAXC) && defined(vms)        /* To avoid %CC-I-PARAMNOTUSED. */
  520. #pragma nostandard
  521. #endif
  522.  
  523. #define VUSERINT              VSIMPLE
  524. #define SEP_USERINT        SEP_SIMPLE
  525. #define INT_USERINT        INT_SIMPLE
  526. #define ZUSERINT              ZSIMPLE
  527. #define STR_USERINT        STR_SIMPLE
  528. #define CCUSERINT            CCSIMPLE
  529. #define AAUSERINT( T,A,B)     BUSERINT(T,A)
  530. #define UUSERINT(  T,A)       NUSERINT(T) (A)
  531.  
  532. #define NUSERINT(  T)       int *
  533. #define BUSERINT(  T,A)     &(A)
  534.  
  535. #if defined(VAXC) && defined(vms)        /* Have avoided %CC-I-PARAMNOTUSED. */
  536. #pragma standard
  537. #endif
  538.  
  539. #define EASY(A,B)      CCALLSFSUB2(EASY,easy,USERINT,INT, A,B)
  540.  
  541. main() {
  542. int a;
  543. printf("\nUsing user defined USERINT argument type.\n");
  544. EASY(a,7);
  545. printf("The FORTRAN routine EASY(a,7) returns a = %d\n", a);
  546. }
  547. #endif
  548.